home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
undith.zip
/
UNDITH.ASC
< prev
Wrap
Text File
|
1993-03-26
|
11KB
|
299 lines
_CONVERTING DITHERED IMAGES BACK TO GRAY SCALE_
by Allen Stenger
[LISTING ONE]
unit User;
{ This is an addition to, and incorporates parts of, the NIH Image program. }
{ NIH Image is written by Wayne Rasband at the National Institutes of Health }
{ and is in the public domain. This addition was written by Allen Stenger, }
{ March 1992. Written in THINK Pascal version 4.0.1. }
{ Replace the User.p supplied with Image with this one. Be sure to uncomment }
{ the call to InitUser in Image.p. If you have a small display you may need }
{ to use ResEdit to shorten the names of the other menu items in Image.rsrc }
{ so the User menu (which comes last) won't be pushed off the end. Use }
{ ResEdit to modify the User Menu in Image.rsrc to make the items Lee Local }
{ Statistics, Ordered Dither, Floyd-Steinberg Dither. }
{ Algorithm references: }
{ Ordered dither: C.N. Judice, J.F. Jarvis, and W.H.Ninke, "Using }
{ Ordered Dither to Display Continuous Tone Pictures on an AC Plasma }
{ Panel." Proceeding of the Society for Information Display v. 15 }
{ no. 4 (Fourth Quarter 1974), not paged. Reprinted in: John C. }
{ Beatty and Kellogg S. Booth (editors), Tutorial: Computer }
{ Graphics, 2nd edition. Silver Spring, MD: IEEE Computer Society }
{ Press, 1982, pp. 220-228.}
{ Lee local statistics: Jong-Sen Lee, "Digital Image Enhancement and }
{ Noise Filtering by Use of Local Statistics." IEEE Transactions on }
{ Pattern Analysis and Machine Intelligence, v. PAMI-2, no. 2 (March }
{ 1980), pp. 165-168. Reprinted in: Rama Chellapa and Alexander A. }
{ Sawchuk (eds.),Digital Image Processing and Analysis v. 1. Silver }
{ Spring, MD: IEEE Computer Society Press, 1985, pp. 440-443. }
interface
uses
QuickDraw, Palettes, PrintTraps, globals, Utilities, Graphics, Analysis,
Camera, Functions;
procedure InitUser;
procedure DoUserMenuEvent (MenuItem: integer);
implementation
type
UserFilterType = (LeeLocalStats, OrderedDither, FloydSteinbergDither);
procedure InitUser;
begin
UserMenuH := GetMenu(UserMenu);
InsertMenu(UserMenuH, 0);
DrawMenuBar;
end;
{ Most of UserFilter is copied with minor modifications from Image (procedure }
{ Filter in Functions.p). The new parts are the Lee local statistics and }
{ ordered dither code. Floyd-Steinberg dither is copied from Filter. }
procedure UserFilter (filterType: UserFilterType);
const
PixelsPerUpdate = 5000; { controls screen updating }
{ constants for Lee local statistics method }
NoiseVariance = 150; { empirical value for Lee method }
{ constants for ordered dither }
DitherSize = 8; { dimensions of ordered dither matrix }
DitherSizeMinus1 = 7; { ditto minus 1 }
type
DitherPattern = array[0..DitherSizeMinus1, 0..DitherSizeMinus1] of 0..255;
var
{ general variables for this procedure }
row, width, r1, r2, r3, c, value, error, sum, tmp, center: integer;
mark, NewMark, LinesPerUpdate, LineCount: integer;
MaskRect, frame: rect;
L1, L2, L3, result: LineType;
pt: point;
AutoSelectAll, UseMask: boolean;
StartTicks: LongInt;
{ variables for Lee local statistics method }
localVariance: longint;
localMean: longint;
gain: real;
i: integer; { loop control }
{ variables for ordered dither }
thePattern: DitherPattern;
procedure PutLineUsingMask (h, v, count: integer;
var line: LineType);
var
aLine, MaskLine: LineType;
i: integer;
SaveInfo: InfoPtr;
begin
if count > MaxPixelsPerLine then
count := MaxPixelsPerLine;
GetLine(h, v, count, aline);
SaveInfo := Info;
Info := UndoInfo;
GetLine(h, v, count, MaskLine);
for i := 0 to count - 1 do
if MaskLine[i] = BlackIndex then
aLine[i] := line[i];
info := SaveInfo;
PutLine(h, v, count, aLine);
end;
procedure MakeDitherPattern (var p: DitherPattern);
var
row: 0..DitherSizeMinus1;
column: 0..DitherSizeMinus1;
halfsize: 1..DitherSize;
scaleFactor: 1..256;
begin
{ The pattern is defined recursively; we implement the recursion }
{ as an iteration. }
p[0, 0] := 0;
halfsize := 1;
while halfsize < DitherSize do begin
for row := 0 to halfsize - 1 do
for column := 0 to halfsize - 1 do begin
p[row, column] := 4 * p[row, column];
p[row, column + halfsize] := p[row, column] + 2;
p[row + halfsize, column] := p[row, column] + 3;
p[row + halfsize, column + halfsize] := p[row, column] + 1;
end;
halfsize := halfsize * 2;
end;
{ adjust scaling for pixel ranges 0..255 }
scaleFactor := 256 div SQR(DitherSize);
for row := 0 to DitherSizeMinus1 do
for column := 0 to DitherSizeMinus1 do
p[row, column] := scaleFactor * p[row, column] + scaleFactor div 2;
end; {MakeDitherPattern}
begin
if NotinBounds then
exit(UserFilter);
StopDigitizing;
AutoSelectAll := not Info^.RoiShowing;
if AutoSelectAll then
with info^ do begin
SelectAll(false);
SetPort(wptr);
PenNormal;
PenPat(pat[PatIndex]);
FrameRect(wrect);
end;
if TooWide then
exit(UserFilter);
ShowWatch;
if info^.RoiType <> RectRoi then
UseMask := SetupMask
else
UseMask := false;
WhatToUndo := UndoFilter;
SetupUndoFromClip;
ShowMessage(CmdPeriodToStop);
frame := info^.RoiRect;
StartTicks := TickCount;
{Set up for ordered dither }
if filterType = OrderedDither then
MakeDitherPattern(thePattern);
with frame, Info^ do begin
changes := true;
RoiShowing := false;
if left > 0 then
left := left - 1;
if right < PicRect.right then
right := right + 1;
width := right - left;
LinesPerUpdate := PixelsPerUpdate div width;
GetLine(left, top, width, L2);
GetLine(left, top + 1, width, L3);
Mark := RoiRect.top;
LineCount := 0;
for row := top + 1 to bottom - 1 do begin
{Move Convolution Window Down}
BlockMove(@L2, @L1, width);
BlockMove(@L3, @L2, width);
GetLine(left, row + 1, width, L3);
{Process One Row}
if CommandPeriod then
exit(UserFilter);
case filterType of
LeeLocalStats:
for c := 1 to width - 2 do begin
localMean := (L1[c] + L1[c + 1] + L1[c + 2]
+ L2[c] + L2[c + 1] + L2[c + 2]
+ L3[c] + L3[c + 1] + L3[c + 2]) div 9;
localVariance := 0;
for i := 0 to 2 do begin
localVariance := localVariance + SQR(L1[c + i]
- localMean);
localVariance := localVariance + SQR(L2[c + i]
- localMean);
localVariance := localVariance + SQR(L3[c + i]
- localMean);
end;
localVariance := localVariance div (3 * 3);
if OptionKeyWasDown then { do extra smoothing }
gain := localVariance /
(localVariance + NoiseVariance * 16.0)
else
gain := localVariance / (localVariance + NoiseVariance);
result[c - 1] :=
round(localMean + gain * (L2[c + 1] - localMean));
if result[c - 1] > 255 then
result[c - 1] := 255;
if result[c - 1] < 0 then
result[c - 1] := 0;
end; {LeeLocalStats}
OrderedDither:
for c := 1 to width - 2 do begin
if L2[c + 1] >=
thePattern[row mod DitherSize, c mod DitherSize] then
result[c - 1] := 255 { dither to black pixel }
else
result[c - 1] := 0; { dither to white pixel }
end; {OrderedDither}
FloydSteinbergDither:
for c := 1 to width - 2 do begin
value := L2[c + 1];
if value < 128 then begin
result[c - 1] := 0;
error := -value;
end
else begin
result[c - 1] := 255;
error := 255 - value
end;
tmp := L2[c + 2]; {A}
tmp := tmp - (7 * error) div 16;
if tmp < 0 then
tmp := 0;
if tmp > 255 then
tmp := 255;
L2[c + 2] := tmp;
tmp := L3[c + 2]; {B}
tmp := tmp - error div 16;
if tmp < 0 then
tmp := 0;
if tmp > 255 then
tmp := 255;
L3[c + 2] := tmp;
tmp := L3[c + 1]; {C}
tmp := tmp - (5 * error) div 16;
if tmp < 0 then
tmp := 0;
if tmp > 255 then
tmp := 255;
L3[c + 1] := tmp;
tmp := L3[c]; {D}
tmp := tmp - (3 * error) div 16;
if tmp < 0 then
tmp := 0;
if tmp > 255 then
tmp := 255;
L3[c] := tmp;
end; {FloydSteinbergDither}
end; {case filterType}
if UseMask then
PutLineUsingMask(left + 2, row, width - 3, result)
else
PutLine(left + 2, row, width - 3, result);
LineCount := LineCount + 1;
if LineCount = LinesPerUpdate then begin
pt.h := RoiRect.left;
pt.v := row + 1;
NewMark := pt.v;
with RoiRect do
SetRect(MaskRect, left, mark, right, NewMark);
UpdateScreen(MaskRect);
LineCount := 0;
Mark := NewMark;
if magnification > 1.0 then
Mark := Mark - 1;
if CommandPeriod then begin
UpdatePicWindow;
beep;
if AutoSelectAll then
KillRoi;
exit(UserFilter)
end;
end;
end; {for row:=...}
trect := frame;
InsetRect(trect, 1, 1);
ShowTime(StartTicks, trect, '');
end; {with}
if LineCount > 0 then begin
with frame do
SetRect(MaskRect, left, mark, right, bottom);
UpdateScreen(MaskRect)
end;
SetupRoiRect;
if AutoSelectAll then
KillRoi;
end;
procedure DoUserMenuEvent (MenuItem: integer);
begin
case MenuItem of { User menu must be set up in this order }
1:
UserFilter(LeeLocalStats);
2:
UserFilter(OrderedDither);
3:
UserFilter(FloydSteinbergDither);
end;
end;
end.